/* GUI CONVERTED from rcshld.p (converter v1.75) Mon May 21 02:41:41 2001 */
/* rcshld.p - SALES ORDER GATEWAY. CREATION SO SHIPPER FOR DIRECT DELIVERY.  */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                       */
/* All rights reserved worldwide.  This is an unpublished work.              */
/* $Revision: 1.13.1.8 $                                                              */
/* REVISION: 8.6  LAST MODIFIED: 06/24/96      BY: *K004* Kurt De Wit        */
/* REVISION: 8.6  LAST MODIFIED: 11/21/96      BY: *K022* Kieu Nguyen        */
/* REVISION: 8.6  LAST MODIFIED: 03/17/97      BY: *K08K* Kieu Nguyen        */
/* REVISION: 8.6  LAST MODIFIED: 04/04/97      BY: *K06J* Kieu Nguyen        */
/* REVISION: 8.6  LAST MODIFIED: 07/12/97      BY: *K0DH* Kieu Nguyen        */
/* REVISION: 8.6  LAST MODIFIED: 10/08/97      BY: *K0NV* Kieu Nguyen        */
/* REVISION: 8.6  LAST MODIFIED: 10/16/97      BY: *K12Q* Kieu Nguyen        */
/* REVISION: 8.6  LAST MODIFIED: 11/10/97      BY: *K18L* Jean Miller        */
/* REVISION: 8.6  LAST MODIFIED: 11/11/97      BY: *K18W* Suresh Nayak       */
/* REVISION: 8.6E LAST MODIFIED: 05/20/98      BY: *K1Q4* Alfred Tan         */
/* REVISION: 8.6E LAST MODIFIED: 06/01/98      BY: *K1NF* Niranjan R.        */
/* REVISION: 8.6E LAST MODIFIED: 10/04/98      BY: *J314* Alfred Tan         */
/* REVISION: 9.0  LAST MODIFIED: 03/29/99      BY: *J3BM* Reetu Kapoor       */
/* REVISION: 9.0  LAST MODIFIED: 09/09/99      BY: *K22T* Kedar Deherkar     */
/* REVISION: 9.0  LAST MODIFIED: 01/11/00      BY: *J3N7* Reetu Kapoor       */
/* REVISION: 9.1  LAST MODIFIED: 08/12/00      BY: *N0KP* myb                */
/* REVISION: 9.1  LAST MODIFIED: 12/28/00      BY: *L13Y* Kaustubh K.        */
/* Old ECO marker removed, but no ECO header exists *F0PN*                   */
/* $Revision: 1.13.1.8 $        BY: Rajaneesh S.        DATE: 05/17/01 ECO: *M17Y*    */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

/*V8:ConvertMode=Maintenance                                                 */

/* DEFINITION OF GLOBAL VARIABLES */
{mfdeclre.i}

/* THE INPUT PARAMETERS CORRESPOND TO THE SHIPPER ID AND THE       */
/* SUPPLIER OF THE abs_mstr RECORD YOU ARE PROCESSING. */

define input parameter shipper_id  like abs_id.
define input parameter supplier_id like abs_shipfrom.
define output parameter undo_tran  like mfc_logical.

define variable next_abs_id        like abs_id.
define variable shipto             like abs_shipto.
define variable abs-recno            as recid.
define variable shiplist             as character.
define variable part_qty           like sod_qty_ord.
define variable part_qty_um        like pt_um.
define variable part_qty_conv      like um_conv.
define variable part_wght          like pt_net_wt.
define variable part_wt_um         like pt_net_wt_um.
define variable part_vol           like pt_size.
define variable part_vol_um        like pt_size_um.
define variable errorst              as logical no-undo.
define variable errornum             as integer no-undo.
define variable invmov             like sgid_inv_mov no-undo.

define shared variable ship_dt      like so_ship_date.
define shared variable eff_date     like glt_effdate.
define shared variable confirm_mode like mfc_logical no-undo.

define            workfile shipper
   field    shipfrom      like abs_shipfrom
   field    shipaddr      like so_ship
   field    shipid        like abs_id.

define buffer absmstr          for abs_mstr.
define buffer absmstr1         for abs_mstr.

define new shared temp-table work_sr_wkfl like sr_wkfl.

{rcwabsdf.i new}
{soabsdef.i new}

confirm_mode = yes.

/* CREATE CONTROL FILE RECORDS IF NECESSARY. */
{gprun.i ""rcpma.p""}
/*GUI*/ if global-beam-me-up then undo, leave.


for first abs_mstr
   fields (abs_cmtindx abs_cust_ref abs_dataset abs_dim_um
           abs_format abs_gwt abs_id abs_inv_mov abs_item
           abs_line abs_loc abs_lotser abs_master_id abs_nwt
           abs_order abs_par_id abs_qty abs_ref abs_shipfrom
           abs_shipto abs_ship_qty abs_shp_date abs_site
           abs_status abs_type abs_vol abs_vol_um abs_wt_um
           abs__qad02 abs__qad03 abs__qad05 abs__qad06)
   where abs_shipfrom = supplier_id
   and   abs_id       = shipper_id no-lock:
end. /* FOR FIRST ABS_MSTR */

/* CHECK FOR SITE SECURITY */
{gprun.i ""gpsiver.p"" "(input abs_shipto,
                         input ?,
                         output return_int)"}
/*GUI*/ if global-beam-me-up then undo, leave.

if return_int = 0
then do:
   {pxmsg.i &MSGNUM=725 &ERRORLEVEL=3}
   /* USER DOES NOT HAVE ACCESS TO THIS SITE. */
   undo_tran = yes.
   return.
end.

shipto = abs_shipto.

for each work_abs_mstr exclusive-lock:
   delete work_abs_mstr.
end.

for each shipper exclusive-lock:
   delete shipper.
end.

/* EXPLODE SHIPPER TO GET ORDER DETAIL */
{gprun.i ""rcsoisa.p"" "(input recid(abs_mstr))"}
/*GUI*/ if global-beam-me-up then undo, leave.


/* CHECK FOR DIRECT DELIVERY SO AND SHIPTO'S AS WELL */
check-loop:
for each work_abs_mstr no-lock
   where work_abs_mstr.abs_id  begins "i"
   and   work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty:

   /* THE VALUE i ABOVE MEANS THAT WE ARE LOOKING FOR ITEM RECORDS IN */
   /* THE abs_mstr (work_abs_mstr) RECORDS. THIS SHOULD NOT BE        */
   /* TRANSLATED.*/

   for first po_mstr
      fields (po_is_btb po_nbr po_so_nbr po_vend)
      where po_nbr  = work_abs_mstr.abs_order
      and   po_vend = work_abs_mstr.abs_shipfrom
      and   po_is_btb no-lock:
   end. /* FOR FIRST PO_MSTR */

   if not available po_mstr
   then
      next check-loop.

   for first pod_det
      fields (pod_line pod_nbr pod_qty_ord pod_sod_line)
      where pod_nbr   = abs_order
      and pod_line    = integer(abs_line)
      and pod_qty_ord > 0 no-lock:
   end. /* FOR FIRST POD_DET */

   if not available pod_det
   then
      next check-loop.

   /* IN ML-EMT THE SBU ALSO CREATES SHIPPER FOR DIR-SHIP ORDER */
   for first so_mstr
      fields (so_conf_date so_nbr so_primary so_ship)
      where so_nbr     = po_so_nbr
      and so_conf_date <> ?
      and so_primary  no-lock:
   end. /* FOR FIRST SO_MSTR */

   if not available so_mstr
   then
      next check-loop.

   for first sod_det
      fields (sod_btb_po sod_btb_pod_line sod_btb_type sod_btb_vend
              sod_cfg_type sod_confirm sod_line sod_nbr sod_part
              sod_sched sod_site sod_um)
      where sod_nbr          = po_so_nbr
      and   sod_line         = pod_sod_line
      and   sod_btb_type     = "03"
      and   sod_btb_po       = work_abs_mstr.abs_order
      and   sod_btb_pod_line =  integer(work_abs_mstr.abs_line)
      and   sod_site         = shipto
      and   sod_part         = work_abs_mstr.abs_item
      and   not sod_sched
      and   sod_confirm no-lock:
   end. /* FOR FIRST SOD_DET */

   if not available sod_det
   then
      next check-loop.

   if lookup(so_ship,shiplist) = 0
   then do:
      /* Add shipto to the shiplist and create new shipper record.*/
      shiplist = shiplist + if shiplist <> "" then "," else "".
      shiplist = shiplist + so_ship.

      {gprun.i ""icshbtb.p"" "(input shipto,
                               input so_ship,
                               output next_abs_id,
                               output invmov,
                               output errorst,
                               output errornum)"}
/*GUI*/ if global-beam-me-up then undo, leave.


      if errorst
      then do:
         if errornum <> 0
         then
            {pxmsg.i &MSGNUM=errornum &ERRORLEVEL=3}
         undo_tran = yes.
         return.
      end.

      /* CREATE HEADER RECORD FOR abs_mstr RECORD. */
      create absmstr.
      assign
         absmstr.abs_shipfrom  = shipto
         absmstr.abs_id        = "s" + next_abs_id
         absmstr.abs_shipto    = so_ship
         absmstr.abs_par_id    = ""
         absmstr.abs_type      = "s"
         absmstr.abs_item      = ""
         absmstr.abs_site      = ""
         absmstr.abs_loc       = ""
         absmstr.abs_lotser    = ""
         absmstr.abs_ref       = ""
         absmstr.abs_order     = ""
         absmstr.abs_line      = ""
         absmstr.abs_qty       = 1
         absmstr.abs_ship_qty  = 0
         absmstr.abs_dataset   = "sod_det"
         absmstr.abs_shp_date  = today
         absmstr.abs_cust_ref  = abs_mstr.abs_cust_ref
         absmstr.abs_master_id = abs_mstr.abs_master_id
         absmstr.abs_cmtindx   = 0
         absmstr.abs__qad01    = abs_mstr.abs__qad01
         absmstr.abs__qad05    = so_ship
         absmstr.abs__qad06    = "0"
         absmstr.abs_inv_mov   =  invmov
         absmstr.abs_format    = abs_mstr.abs_format
         /* MARK THE SHIPPER AS PRINTED IMMEDIATELY */
         substring(absmstr.abs_status,1,1) = "y".

      create shipper.
      assign
         shipfrom = shipto
         shipid   = "s" + next_abs_id
         shipaddr = so_ship.
   end. /* lookup(so_ship,shiplist) = 0 */
end. /* check-loop */

/* IF NO BTB LINES OF TYPE 03 (DIRECT DELIVERY) ARE FOUND THEN     */
/* RETURN BECAUSE NO SO SHIPMENT HAS TO BE DONE.                   */
if shiplist = ""
then
   return.

processing-loop:
for each work_abs_mstr no-lock
   where work_abs_mstr.abs_id begins "i"
   and   work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty
   and not trim(substring(work_abs_mstr.abs__qad10,1,1))
   begins "X",

      /* THE VALUE i ABOVE MEANS THAT WE ARE LOOKING FOR ITEM RECORDS IN */
      /* THE abs_mstr (work_abs_mstr) RECORDS. THIS SHOULD NOT BE        */
      /* TRANSLATED.*/

      first abs_mstr no-lock
         where abs_mstr.abs_shipfrom = work_abs_mstr.abs_shipfrom
         and   abs_mstr.abs_id       = work_abs_mstr.abs_id,
      first po_mstr no-lock
         where po_nbr  = work_abs_mstr.abs_order
         and   po_vend = work_abs_mstr.abs_shipfrom
         and po_is_btb,
      first pod_det no-lock
         where pod_nbr     = abs_order
         and   pod_line    = integer(abs_line)
         and pod_qty_ord > 0,
      first sod_det no-lock
         where sod_btb_type     = "03"
         and   sod_btb_po       = work_abs_mstr.abs_order
         and   sod_btb_pod_line = integer(abs_line)
         and   sod_btb_vend     = work_abs_mstr.abs_shipfrom
         and   sod_nbr          = po_so_nbr
         and   sod_line         = pod_sod_line
         and   sod_site         = shipto
         and   sod_part         = work_abs_mstr.abs_item
         and not sod_sched
         and sod_confirm,
      first so_mstr no-lock
         where so_nbr           =  sod_nbr
         and so_conf_date       <> ?
         and so_primary         = yes
         break by so_ship:

   if first-of(so_ship)
   then
      find first shipper
         where shipaddr = so_ship
         no-lock no-error.

   /* CREATE CONTENTS OF THE abs_mstr HEADER RECORD */
   /* SET DEFAULTS FOR UM, WEIGHTS AND VOLUME */
   assign
      part_qty_um   = ""
      part_qty_conv = 1
      part_wght     = 0
      part_wt_um    = ""
      part_vol      = 0
      part_vol_um   = "".

   for first pt_mstr
      fields (pt_net_wt pt_net_wt_um pt_part pt_size
              pt_size_um pt_um)
      where pt_part = work_abs_mstr.abs_item no-lock:
   end. /* FOR FIRST PT_MSTR */

   if available pt_mstr
   then do:
      assign
         part_qty_um   = pt_um
         part_qty_conv = 1
         part_wght     = pt_net_wt
         part_wt_um    = pt_net_wt_um
         part_vol      = pt_size
         part_vol_um   = pt_size_um.
      if sod_um <> pt_um
      then do:
         /* FIND UM CONVERSION FACTOR */
         {gprun.i ""gpumcnv.p""
                  "(input sod_um,
                    input pt_um,
                    input pt_part,
                    output part_qty_conv)"}
/*GUI*/ if global-beam-me-up then undo, leave.


         if part_qty_conv = ?
         then
            part_qty_conv = 1.
      end.
   end. /* pt_mstr available */

   /* STORING THE QUANTITY IN SO UM */

   create absmstr1.
   assign
      absmstr1.abs_shipfrom = sod_site
      absmstr1.abs_id       = "i" + shipid + sod_site +
                               sod_nbr + string(sod_line) +
                               sod_part +
                               work_abs_mstr.abs_loc +
                               work_abs_mstr.abs_lotser +
                               work_abs_mstr.abs_ref
      absmstr1.abs_par_id   = shipid
      absmstr1.abs_shipto   = so_ship
      absmstr1.abs_shp_date = today
      absmstr1.abs_type     = "s"
      absmstr1.abs_item     = work_abs_mstr.abs_item
      absmstr1.abs_site     = shipto
      absmstr1.abs_loc      = work_abs_mstr.abs_loc
      absmstr1.abs_lotser   = work_abs_mstr.abs_lotser
      absmstr1.abs_ref      = work_abs_mstr.abs_ref
      absmstr1.abs_order    = sod_nbr
      absmstr1.abs_line     = string(sod_line)
      absmstr1.abs_qty      = work_abs_mstr.abs_qty / sod_um_conv
      absmstr1.abs_ship_qty = 0
      absmstr1.abs__qad06   = "1"
      absmstr1.abs_gwt      = part_wght * work_abs_mstr.abs_qty
      absmstr1.abs_nwt      = part_wght * work_abs_mstr.abs_qty
      absmstr1.abs_vol      = part_vol  * work_abs_mstr.abs_qty
      absmstr1.abs_wt_um    = part_wt_um
      absmstr1.abs_vol_um   = part_vol_um
      absmstr1.abs__qad02   = sod_um
      absmstr1.abs__qad03   = string(part_qty_conv)
      .

   if recid(absmstr1) = -1 then.

   /*ADJUST GROSS WEIGHT FOR PARENT SHIPPER */
   {gprun.i ""rcctwbc4.p"" "(input recid(absmstr1),
                             input absmstr1.abs_nwt,
                             input absmstr1.abs_wt_um)"}
/*GUI*/ if global-beam-me-up then undo, leave.


   if sod_cfg_type <> "2"
   then
      next processing-loop.

   /* CREATE qad_wkfl FOR EACH COMPONENT */
   run crt-qad-wkfl (input work_abs_mstr.abs_id ,
                     input work_abs_mstr.abs_shipfrom,
                     input sod_nbr,
                     input sod_line,
                     input so_ship,
                     input shipto).

   /* ADDED PARAMETER det_all AS 'no' BUT HAS NO SIGNIFICANCE FOR THIS
    * INVOCATION */
   /* CREATE abs_mstr RECORD FROM qad_wkfl  */
   {gprun.i ""rcshwbc3.p""
      "(input recid(absmstr1),
        input recid(sod_det),
        input 1,
        input absmstr1.abs_qty ,
        input absmstr1.abs_site,
        input absmstr1.abs_loc,
        input absmstr1.abs_lotser,
        input absmstr1.abs_ref,
        input "no")"}
/*GUI*/ if global-beam-me-up then undo, leave.


   /* DELETE KIT COMPONENTS RECORDS FROM qad_wkfl */
   {gprun.i ""rcshwbc4.p""
            "(input recid(sod_det))"}
/*GUI*/ if global-beam-me-up then undo, leave.


end. /* processing-loop */

for each shipper no-lock:
/*GUI*/ if global-beam-me-up then undo, leave.

  /* PERFORM SO SHIPPER CONFIRM */
  {gprun.i ""rcsois2.p"" "(input shipfrom,
                           input shipid,
                           input ship_dt,
                           input eff_date)"}
/*GUI*/ if global-beam-me-up then undo, leave.

end.
/*GUI*/ if global-beam-me-up then undo, leave.


/* DELETE ALL WORKFILES */
for each shipper exclusive-lock:
   delete shipper.
end.
undo_tran = no.

PROCEDURE crt-qad-wkfl:
/* FOR TRANSHIPMENTS CREATE qad_wkfl for KIT COMPONENTS */

   define input parameter parent_id       like abs_mstr.abs_id.
   define input parameter parent_shipfrom like abs_mstr.abs_shipfrom.
   define input parameter sodnbr          like sod_nbr.
   define input parameter sodline         like sod_line.
   define input parameter soship          like so_ship.
   define input parameter sodsite         like sod_site.

   define buffer abs_comp          for abs_mstr.

   for each abs_comp no-lock
      where abs_comp.abs_shipfrom = parent_shipfrom
      and abs_comp.abs_par_id     = parent_id:

      find qad_wkfl
         where qad_key1 = mfguser + global_db + "stage_component"
         and qad_key2 = sodnbr + ","
                        + string(sodline) + ","
                        + abs_comp.abs_item         + ","
                        + sodsite          + ","
                        + abs_comp.abs_loc           + ","
                        + abs_comp.abs_lotser        + ","
                        + abs_comp.abs_ref
         no-lock no-error.

      if not available qad_wkfl
      then do:
         create qad_wkfl.
         assign
            qad_key1 = mfguser + global_db + "stage_component"
            qad_key2 = sodnbr + ","
                       + string(sodline)       + ","
                       + abs_comp.abs_item     + ","
                       + sodsite               + ","
                       + abs_comp.abs_loc      + ","
                       + abs_comp.abs_lotser   + ","
                       + abs_comp.abs_ref
            qad_key3 = sodnbr
            qad_key4 = string(sodline)
            qad_key5 = string(sodline)
            qad_key6 = abs_comp.abs_item
            qad_decfld[1] = abs_comp.abs_qty
            qad_charfld[1] = sodsite
            qad_charfld[2] = abs_comp.abs_item
            qad_charfld[3] = abs_comp.abs_loc
            qad_charfld[4] = abs_comp.abs_lotser
            qad_charfld[5] = abs_comp.abs_ref
            qad_charfld[6] = soship
            qad_charfld[7] = sodnbr
            qad_charfld[8] = string(sodline)
            qad_charfld[9] = ""
            qad_charfld[10] = ""
            qad_charfld[11] = "".

      end. /* NOT AVAILABLE qad_wkfl */

   end.   /* FOR EACH abs_comp */

end.  /*  PROCEDURE  */
